Brownian Motion Maze Solving

An adapted example from Wolfram Community (Christopher Wolfram)

dims={8,12};
hallwayThickness=0.8;
ballCount=1000; 

spanningTree = FindSpanningTree[GridGraph[dims, EdgeWeight->{_:>RandomReal[]}]]

(*VB[*)(CoffeeLiqueur`Extensions`Boxes`Workarounds`temporal$3001032)(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKpySbmaSaJxrqJhmmmumaJCcl6iaZWBjqplqkGCWnGaekGphbAgCUYRZh"*)(*]VB*)

Create walls using regions

outerRegion = Rectangle[
    {1, 1} - 1 + hallwayThickness, 
    Reverse[dims] + 1
];

wallsRegion = RegionDifference[
    RegionDifference[
        Rectangle[
            {1, 1} - 1 + hallwayThickness, 
            Reverse[dims] + 1
        ],
        RegionDilation[
            DiscretizeGraphics[
                Line[
                    GraphEmbedding[spanningTree][[#]] & /@ 
                    List @@@ EdgeList[spanningTree]
                ] // Graphics
            ],
            Rectangle[{0, 0}, {1, 1} * hallwayThickness]
        ]
    ],
    Rectangle[
        {dims[[2]], hallwayThickness}, 
        {dims[[2]], 0} + {hallwayThickness, 1}
    ]
];

Testing functions

wallMember = RegionMember[wallsRegion];
mazeMember = RegionMember[outerRegion];
initPs = {1 + hallwayThickness/2, dims[[1]] + hallwayThickness/2};

Run the simulation

positionSeries = 
 Module[{ps, vs, vps, skip = 10}, 
   ps = ConstantArray[initPs, ballCount];
   vps = ps;
   
   Show[Graphics[
    {
     Orange, 
     Point[vps // Offload]
    }, 
    ImageSize -> 500, TransitionType->None
   ], wallsRegion] // Print;
   
   
   Reap[
     Sow[ps];
     While[And @@ mazeMember[ps], 
      vs = RandomPoint[Circle[], ballCount] * 0.1;
      ps += vs;
      ps -= vs * Boole[wallMember[ps]];
      If[skip <= 0, vps = ps; skip = 10;, skip--];
      Sow[ps]
     ]
   ][[2, 1]]
];

(*VB[*)(FrontEndRef["72e40b87-611b-49ab-84e7-09a618676961"])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKmxulmhgkWZjrmhkaJumaWCYm6VqYpJrrGlgmmhlamJmbWZoZAgB4eBTE"*)(*]VB*)

Winning index

winningIndex=FirstPosition[mazeMember@Last@positionSeries,False][[1]]

Show it on maze

Show[Graphics[{Orange,Line[positionSeries[[All,winningIndex]]]},ImageSize->500], wallsRegion]

(*VB[*)(FrontEndRef["1fffa7cd-b284-4648-a5a5-77d29bf79842"])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKG6alpSWaJ6foJhlZmOiamJlY6CaaJprqmpunGFkmpZlbWpgYAQCPzxW6"*)(*]VB*)